home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hugegrid / hugegrid.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-06  |  13.9 KB  |  477 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3885
  5.    ClientLeft      =   1875
  6.    ClientTop       =   1680
  7.    ClientWidth     =   4800
  8.    Height          =   4290
  9.    Left            =   1815
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3885
  13.    ScaleWidth      =   4800
  14.    Top             =   1335
  15.    Width           =   4920
  16.    Begin VScrollBar VScroll1 
  17.       Height          =   2430
  18.       LargeChange     =   9
  19.       Left            =   4395
  20.       Max             =   5000
  21.       Min             =   1
  22.       TabIndex        =   5
  23.       Top             =   1305
  24.       Value           =   5000
  25.       Width           =   300
  26.    End
  27.    Begin Grid Grid1 
  28.       Cols            =   3
  29.       FixedCols       =   0
  30.       FixedRows       =   0
  31.       Height          =   2430
  32.       Left            =   105
  33.       Rows            =   10
  34.       TabIndex        =   6
  35.       Top             =   1305
  36.       Width           =   4290
  37.    End
  38.    Begin TextBox T_Input 
  39.       Height          =   375
  40.       Left            =   120
  41.       TabIndex        =   0
  42.       Text            =   "4321.99"
  43.       Top             =   840
  44.       Width           =   1200
  45.    End
  46.    Begin CommandButton B_Quit 
  47.       Caption         =   "&Quit"
  48.       Height          =   495
  49.       Left            =   3855
  50.       TabIndex        =   4
  51.       Top             =   750
  52.       Width           =   840
  53.    End
  54.    Begin PictureBox Picture1 
  55.       BorderStyle     =   0  'None
  56.       Height          =   570
  57.       Left            =   4095
  58.       Picture         =   HUGEGRID.FRX:0000
  59.       ScaleHeight     =   570
  60.       ScaleWidth      =   555
  61.       TabIndex        =   7
  62.       Top             =   105
  63.       Width           =   555
  64.    End
  65.    Begin CommandButton B_Del 
  66.       Caption         =   "&Delete"
  67.       Height          =   495
  68.       Left            =   3000
  69.       TabIndex        =   9
  70.       Top             =   120
  71.       Width           =   825
  72.    End
  73.    Begin CommandButton B_Insert 
  74.       Caption         =   "&Insert"
  75.       Height          =   510
  76.       Left            =   2040
  77.       TabIndex        =   3
  78.       Top             =   105
  79.       Width           =   840
  80.    End
  81.    Begin CommandButton B_Find 
  82.       Caption         =   "&Find"
  83.       Height          =   495
  84.       Left            =   1080
  85.       TabIndex        =   2
  86.       Top             =   120
  87.       Width           =   840
  88.    End
  89.    Begin CommandButton B_Sort 
  90.       Caption         =   "&Sort"
  91.       Height          =   495
  92.       Left            =   120
  93.       TabIndex        =   1
  94.       Top             =   120
  95.       Width           =   840
  96.    End
  97.    Begin Label Label1 
  98.       Caption         =   "Enter a number to search column 1 for or to insert. "
  99.       Height          =   405
  100.       Left            =   1425
  101.       TabIndex        =   8
  102.       Top             =   825
  103.       Width           =   2280
  104.    End
  105. Dim Entry As Element
  106. Dim pointer&(6000)
  107. 'Rather than move elements around in an array (or on disk, if you use these
  108. 'routines with a random access file instead), we use pointers to the records
  109. 'instead.
  110. Dim Deleted&(6000), NumDeleted
  111. 'Again, rather than move data around when when an element is deleted,
  112. 'we keep track of deleted elements and reuse them when adding new elements.
  113. 'Of course, when saving to disk, you would ignore the deleted elements.
  114. Dim GridStart  'pointer number of the first element on the grid
  115. Dim CurEl      'pointer number of the last element found on a search
  116. Dim LastElement  'number of elements in the Array - 5000, in this example
  117. Dim ArraySorted  'flag to show if the Huge Array is sorted.
  118. Dim PgAmt        'number of lines to page up and down by
  119. Dim Bottom(10), Topp(10)   'variables used in the sort routine.
  120. Dim LastValue  'last value selected on scroll bar
  121. Dim IgnoreChange  'flag to allow changing Vscroll1.value without executing
  122.                   'Vscroll1.Change
  123. Dim MatchRow 'Grid row number where matching item is after a Find
  124. 'Copyright 1991 Nelson Ford, Public (software) Library
  125. Sub B_Del_Click ()
  126.   If Grid1.CellSelected = 0 Then
  127.     If Grid1.SelStartRow = Grid1.SelEndRow And Grid1.SelStartCol = Grid1.SelEndCol Then
  128.       Grid1.Row = Grid1.SelStartRow
  129.       Grid1.Col = Grid1.SelStartCol
  130.     Else
  131.       MsgBox "Cell not selected."
  132.       Exit Sub
  133.     End If
  134.   End If
  135.   r = GridStart + Grid1.Row  'array element number
  136.   x = MsgBox("Delete entire row?", 3)
  137.   If x = 2 Then
  138.     Exit Sub
  139.   ElseIf x = 7 Then 'just delete cell, not the entire entry
  140.     Grid1.Text = ""
  141.     Grid1.Col = 0: Entry.a1 = Grid1.Text
  142.     Grid1.Col = 1: Entry.a2 = Grid1.Text
  143.     Grid1.Col = 2: Entry.a3 = Grid1.Text
  144.     e = SetHugeEl(hArray, pointer&(r), Entry)
  145.     If e < 0 Then MsgBox "Error deleting data."
  146.   Else
  147.     NumDeleted = NumDeleted + 1
  148.     Deleted&(NumDeleted) = pointer&(r)
  149.     For i = r To LastElement
  150.       pointer&(i) = pointer&(i + 1)
  151.     Next
  152.     Call DecrLastEl
  153.     rw = Grid1.Row
  154.     If GridStart + 9 < LastElement Then
  155.       Call ScrollUp(rw, 8)
  156.       Call FillGrid(GridStart + 9, GridStart + 9, 9)
  157.     Else
  158.       GridStart = GridStart - 1
  159.       Call ScrollDown(1, rw)
  160.       Call FillGrid(GridStart, GridStart, 0)
  161.     End If
  162.   End If
  163.   T_Input.SetFocus
  164.   'Copyright 1991 Nelson Ford, Public (software) Library
  165. End Sub
  166. Sub B_Find_Click ()
  167.   If T_Input.Text = "" Then
  168.     MsgBox "Nothing entered."
  169.     Exit Sub
  170.   End If
  171.   u = LastElement
  172.   l = 1
  173.     If u < l Then Exit Do
  174.     i = (l + u) / 2
  175.     x = GetHugeEl(hArray, pointer&(i), Entry): If x < 0 Then Stop
  176.     'Debug.Print l; u, T_Input.Text, Entry.a1
  177.     If T_Input.Text = RTrim$(LTrim$(Entry.a1)) Then
  178.       Exit Do
  179.     ElseIf T_Input.Text > RTrim$(LTrim$(Entry.a1)) Then
  180.       l = i + 1
  181.     Else
  182.       u = i - 1
  183.     End If
  184.   Loop
  185.   CurEl = i
  186.   StartPt = i - 1
  187.   If StartPt < 1 Then
  188.     StartPt = 1
  189.     MatchRow = 0
  190.   ElseIf StartPt > LastElement - 9 Then
  191.     StartPt = LastElement - 9
  192.     MatchRow = LastElement - StartPt
  193.   Else
  194.     MatchRow = 1
  195.   End If
  196.   IgnoreChange = -1
  197.   If StartPt + 9 >= LastElement Then
  198.     Vscroll1.Value = LastElement
  199.   ElseIf StartPt = 1 Then
  200.     Vscroll1.Value = 1
  201.   Else
  202.     Vscroll1.Value = StartPt
  203.   End If
  204.   IgnoreChange = 0
  205.   LastValue = Vscroll1.Value
  206.   Call FillGrid(StartPt, StartPt + 9, 0)
  207.   GridStart = StartPt
  208.   Grid1.Row = MatchRow
  209.   Grid1.SelStartRow = MatchRow
  210.   Grid1.SelEndRow = MatchRow
  211.   Grid1.SelStartCol = 0
  212.   Grid1.SelEndCol = 0
  213.   T_Input.SetFocus
  214. End Sub
  215. Sub B_Insert_Click ()
  216.   If LastElement = ArraySize Then
  217.     MsgBox "Out of room."
  218.     Exit Sub
  219.   ElseIf T_Input.Text = "" Then
  220.     MsgBox "Enter something in the Text Box."
  221.     Exit Sub
  222.   End If
  223.   Call B_Find_Click
  224.   Grid1.Row = MatchRow
  225.   Grid1.Col = 0
  226.   'If a match was not found, the contents of Grid.Row=MatchRow, .Col=0
  227.   '  will be the closest match value.
  228.   'Test to see if the new value is < or => the contents of that cell:
  229.   If MatchRow < 5 Then
  230.     If T_Input.Text < RTrim$(LTrim$(Grid1.Text)) Then
  231.       Call ScrollDown(MatchRow + 1, 9)
  232.       Grid1.Row = MatchRow
  233.       CurEl = GridStart + MatchRow
  234.     Else
  235.       Call ScrollDown(MatchRow + 2, 9)
  236.       Grid1.Row = MatchRow + 1
  237.       CurEl = GridStart + MatchRow + 1
  238.     End If
  239.   Else
  240.     If T_Input.Text < RTrim$(LTrim$(Grid1.Text)) Then
  241.       Call ScrollUp(0, MatchRow - 2)
  242.       Grid1.Row = MatchRow - 1
  243.       CurEl = GridStart + MatchRow
  244.     Else
  245.       Call ScrollUp(0, MatchRow - 1)
  246.       Grid1.Row = MatchRow
  247.       CurEl = GridStart + MatchRow + 1
  248.     End If
  249.   End If
  250.   Grid1.Col = 0
  251.   Entry.a1 = T_Input.Text
  252.   Grid1.Text = T_Input.Text
  253.   Grid1.Col = 1
  254.   Entry.a2 = ""
  255.   Grid1.Text = ""
  256.   Grid1.Col = 2
  257.   Entry.a3 = ""
  258.   Grid1.Text = ""
  259.   Call IncrLastEl
  260.   If MatchRow > 5 Then GridStart = GridStart + 1
  261.   For i = LastElement To CurEl + 1 Step -1
  262.     pointer&(i) = pointer&(i - 1)
  263.   Next
  264.   If NumDeleted > 0 Then
  265.     pointer&(CurEl) = Deleted&(NumDeleted)
  266.     NumDeleted = NumDeleted - 1
  267.   Else
  268.     pointer&(CurEl) = LastElement
  269.   End If
  270.   e = SetHugeEl(hArray, pointer&(CurEl), Entry)
  271.   If e < 0 Then MsgBox "Error in inserting data.": Stop
  272.   T_Input.SetFocus
  273. End Sub
  274. Sub B_Quit_Click ()
  275.   i = HugeErase(hArray)
  276.   End
  277. End Sub
  278. Sub B_Sort_Click ()
  279.   MousePointer = 11
  280.   Ply = 1
  281.   Bottom(1) = 1
  282.   Topp(1) = LastElement
  283.   While Ply > 0
  284.     If Bottom(Ply) >= Topp(Ply) Then
  285.       Ply = Ply - 1
  286.     Else
  287.       i = Bottom(Ply) - 1
  288.       j = Topp(Ply)
  289.       Pt$ = GetEl$(j)
  290.       While i < j
  291.         i = i + 1
  292.         j = j - 1
  293.         While GetEl$(i) < Pt$
  294.           i = i + 1
  295.         Wend
  296.         While GetEl$(j) > Pt$ And j > i
  297.           j = j - 1
  298.         Wend
  299.         If i < j Then
  300.           x = pointer&(i)
  301.           pointer&(i) = pointer&(j)
  302.           pointer&(j) = x
  303.         End If
  304.       Wend
  305.       j = Topp(Ply)
  306.       ii$ = GetEl$(i)
  307.       If i <> j And ii$ > GetEl$(j) Then
  308.         x = pointer&(i)
  309.         pointer&(i) = pointer&(j)
  310.         pointer&(j) = x
  311.       End If
  312.       If i - Bottom(Ply) < Topp(Ply) - i Then
  313.         Bottom(Ply + 1) = Bottom(Ply)
  314.         Topp(Ply + 1) = i - 1
  315.         Bottom(Ply) = i + 1
  316.       Else
  317.         Topp(Ply + 1) = Topp(Ply)
  318.         Bottom(Ply + 1) = i + 1
  319.         Topp(Ply) = i - 1
  320.       End If
  321.       Ply = Ply + 1
  322.     End If
  323.   Wend
  324.   MousePointer = 0
  325.   ArraySorted = -1
  326.   Call FillGrid(1, 10, 0): IgnoreChange = -1
  327.   Vscroll1.Value = 10: IgnoreChange = 0
  328. End Sub
  329. Sub DecrLastEl ()
  330.   'takes care of all the ramifications of decreasing LastElement
  331.   LastElement = LastElement - 1
  332.   IgnoreChange = -1
  333.   Vscroll1.Max = LastElement
  334.   IgnoreChange = 0
  335.   If LastValue > LastElement Then LastValue = LastElement
  336. End Sub
  337. Sub FillGrid (StartPt, StopPt, StartRow)
  338.   For i = StartPt To StopPt
  339.     x = GetHugeEl(hArray, pointer&(i), Entry)
  340.     If x > 0 Then Stop
  341.     Grid1.Row = i - StartPt + StartRow
  342.     Grid1.Col = 0
  343.     Grid1.Text = Entry.a1
  344.     Grid1.Col = 1
  345.     Grid1.Text = Entry.a2
  346.     Grid1.Col = 2
  347.     Grid1.Text = Entry.a3
  348.   Next
  349. End Sub
  350. Sub Form_Load ()
  351.   Form1.Show
  352.   MousePointer = 11
  353.   ArraySize = 6000
  354.   LastElement = 5000  'amount of data we are going to stuff into the array
  355.   SortedArray = 0
  356.   'Set width of each grid column:
  357.   Grid1.Col = 0: Grid1.Colwidth = 1200
  358.   Grid1.Col = 1: Grid1.Colwidth = 1400
  359.   Grid1.Col = 2: Grid1.Colwidth = 1600
  360.   'Set up Scroll bar values:
  361.   Vscroll1.Max = LastElement
  362.   Vscroll1.Min = 1
  363.   Vscroll1.LargeChange = Grid1.Rows - 1
  364.   Vscroll1.SmallChange = 1: IgnoreChange = -1
  365.   Vscroll1.Value = LastElement: IgnoreChange = 0
  366.   LastValue = LastElement
  367.   'Set up HugeArray (requires Hugearr.dll in PATH)
  368.   hArray = HugeDim(Len(Entry), ArraySize)
  369.   If hArray < 0 Then
  370.     MsgBox "Error dimensioning array: " + Str$(hArray)
  371.     Stop
  372.   End If
  373.   'fill array with dummy data
  374.   For i = 1 To LastElement
  375.     Entry.a1 = Mid$(Str$(i + .1), 2)
  376.     Entry.a2 = Mid$(Str$(i + .2), 2)
  377.     Entry.a3 = Mid$(Str$(i + .3), 2)
  378.     pointer&(i) = i
  379.     x = SetHugeEl(hArray, pointer&(i), Entry)
  380.     If x > 0 Then Stop
  381.   Next
  382.   'display last 10 entries in the Grid:
  383.   GridStart = LastElement - 9
  384.   Call FillGrid(GridStart, LastElement, 0)
  385.   Grid1.Row = 0
  386.   Grid1.Col = 0
  387.   Grid1.SelStartRow = 0
  388.   Grid1.SelStartCol = 0
  389.   T_Input.SetFocus
  390.   MousePointer = 0
  391. End Sub
  392. Function GetEl (x) As String
  393.   e = GetHugeEl(hArray, pointer&(x), Entry): If e < 0 Then Stop
  394.   GetEl$ = Entry.a1
  395. End Function
  396. Sub IncrLastEl ()
  397.   'takes care of all the ramifications of increasing LastElement
  398.   LastElement = LastElement + 1
  399.   IgnoreChange = -1
  400.   Vscroll1.Max = LastElement
  401.   If Vscroll1.Value > Vscroll1.Max - 10 Then
  402.     Vscroll1.Value = Vscroll1.Max
  403.     LastValue = Vscroll1.Value
  404.   End If
  405.   IgnoreChange = 0
  406. End Sub
  407. Sub Picture1_Click ()
  408.   m$ = "Public (software) Library is the most extensive collection of pd/shareware available. "
  409.   m$ = m$ + "We have a large collection of routines for all languages, including VB. "
  410.   m$ = m$ + "For a catalog, call 800-242-4PsL or write PsL, P.O.Box 35705, Houston, TX 77235-5705."
  411.   MsgBox m$
  412. End Sub
  413. Sub ScrollDown (StartRow, StopRow)
  414.   For i = StopRow To StartRow Step -1
  415.     Grid1.Row = i - 1
  416.     Grid1.Col = 0
  417.     x0$ = Grid1.Text
  418.     Grid1.Col = 1
  419.     x1$ = Grid1.Text
  420.     Grid1.Col = 2
  421.     x2$ = Grid1.Text
  422.     Grid1.Row = i
  423.     Grid1.Col = 0
  424.     Grid1.Text = x0$
  425.     Grid1.Col = 1
  426.     Grid1.Text = x1$
  427.     Grid1.Col = 2
  428.     Grid1.Text = x2$
  429.   Next
  430. End Sub
  431. Sub ScrollUp (StartRow, StopRow)
  432.   For i = StartRow To StopRow
  433.     Grid1.Row = i + 1
  434.     Grid1.Col = 0
  435.     x0$ = Grid1.Text
  436.     Grid1.Col = 1
  437.     x1$ = Grid1.Text
  438.     Grid1.Col = 2
  439.     x2$ = Grid1.Text
  440.     Grid1.Row = i
  441.     Grid1.Col = 0
  442.     Grid1.Text = x0$
  443.     Grid1.Col = 1
  444.     Grid1.Text = x1$
  445.     Grid1.Col = 2
  446.     Grid1.Text = x2$
  447.   Next
  448. End Sub
  449. Sub T_Input_GotFocus ()
  450.   T_Input.SelStart = 0
  451.   T_Input.SelLength = 32767
  452. End Sub
  453. Sub Vscroll1_Change ()  'See "Change Property" in the VB Manual.
  454. 'Stop
  455.   If IgnoreChange Then Exit Sub
  456.   If Vscroll1.Value = LastValue - 1 Then 'up arrow clicked: scroll down
  457.     GridStart = GridStart - 1
  458.     Call ScrollDown(1, 9)
  459.     Call FillGrid(GridStart, GridStart, 0)
  460.   ElseIf Vscroll1.Value = LastValue + 1 Then 'down arrow clicked: scroll up
  461.     GridStart = GridStart + 1
  462.     Call ScrollUp(0, 8)
  463.     Call FillGrid(GridStart + 9, GridStart + 9, 9)
  464.   Else
  465.     If Vscroll1.Value = LastValue - 9 Then  'clicked above handle: page down
  466.       GridStart = GridStart - 9
  467.     ElseIf Vscroll1.Value = LastValue + 9 Then 'clicked below handle: page up
  468.       GridStart = GridStart + 9
  469.     Else                                       'moved handle
  470.       GridStart = Vscroll1.Value
  471.       If GridStart > LastElement - 9 Then GridStart = LastElement - 9
  472.     End If
  473.     Call FillGrid(GridStart, GridStart + 9, 0)
  474.   End If
  475.   LastValue = Vscroll1.Value
  476. End Sub
  477.